;; https://projecteuler.net/problem=23

;; Non-abundant sums

;; Problem 23

;; A perfect number is a number for which the sum of its proper
;; divisors is exactly equal to the number. For example, the sum of
;; the proper divisors of 28 would be 1 + 2 + 4 + 7 + 14 = 28, which
;; means that 28 is a perfect number.

;; A number n is called deficient if the sum of its proper divisors is
;; less than n and it is called abundant if this sum exceeds n.

;; As 12 is the smallest abundant number, 1 + 2 + 3 + 4 + 6 = 16, the
;; smallest number that can be written as the sum of two abundant
;; numbers is 24. By mathematical analysis, it can be shown that all
;; integers greater than 28123 can be written as the sum of two
;; abundant numbers. However, this upper limit cannot be reduced any
;; further by analysis even though it is known that the greatest
;; number that cannot be expressed as the sum of two abundant numbers
;; is less than this limit.

;; Find the sum of all the positive integers which cannot be written
;; as the sum of two abundant numbers.


(import
 (except (rnrs base) let-values map)
 (only (guile)
       lambda* λ
       inexact->exact
       current-output-port)
 (srfi srfi-1)  ; list stuff
 (srfi srfi-69)  ; hash tables
 (contract)
 (prefix (lib math) math:)
 (lib stream))


;; Above this upper limit, all integers can be written as
;; sums of 2 abundant numbers.
(define upper-limit 28123)


(define-with-contract factors-sum
  (require (integer? num)
           (positive? num))
  (ensure (integer? <?>)
          (or (positive? <?>)
              (= <?> 0)))
  (λ (num)
    (math:sum (math:factors num))))


(define-with-contract abundant?
  (require (integer? num)
           (positive? num))
  (ensure (boolean? <?>))
  (λ (num)
    (>= (factors-sum num) num)))


(define get-abundant-numbers
  (λ (start end)
    (cond
     [(> start end) '()]
     [(abundant? start)
      (cons start
            (get-abundant-numbers (+ start 1) end))]
     [else
      (get-abundant-numbers (+ start 1) end)])))


(define list->hash-table
  (λ (lst)
    (alist->hash-table
     (map (λ (num) (cons num #t))
          lst))))


(define-with-contract sum-of-two-abundant-numbers?
  (require (hash-table? abundant-numbers-lookup-table)
           (pair? abundant-numbers)
           (integer? num)
           (positive? num))
  (ensure (boolean? <?>))
  (λ (num
      abundant-numbers
      abundant-numbers-lookup-table)
    "Check, whether a number is a sum of 2 abundant
numbers."
    (let ([limit (inexact->exact (floor (/ num 2)))])
      (let iter ([°abundant-numbers abundant-numbers])
        (let* ([abundant-number (first °abundant-numbers)]
               [difference (- num abundant-number)])
          (cond
           [(> abundant-number limit)
            #f]
           [(hash-table-ref/default abundant-numbers-lookup-table
                                    difference
                                    #f)
            #t]
           [else
            (iter (cdr °abundant-numbers))]))))))


(define abundant-numbers (get-abundant-numbers 1 upper-limit))
(define abundant-number-lookup-table (list->hash-table abundant-numbers))
(define natural-numbers
  (make-stream 0 0 0
               (λ (val index prev-input) (+ prev-input 1))
               (λ (x) x)))

(let ([start 1]
      [end upper-limit])
  (simple-format
   (current-output-port) "~a\n"
   (math:sum
    ;; Would be nice to be able to filter streams, so that
    ;; one does not have to have all the natural numbers up
    ;; to the upper limit in memory.
    (filter (λ (num)
              (not (sum-of-two-abundant-numbers? num
                                                 abundant-numbers
                                                 abundant-number-lookup-table)))
            (drop (stream->list natural-numbers (+ upper-limit 1)) 1)))))
